home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_pas / ddplus63.zip / DDOVR2.PAS < prev    next >
Pascal/Delphi Source File  |  1994-07-09  |  8KB  |  320 lines
  1.  
  2. unit ddovr2;
  3.  
  4. {$O+,F+,V-}
  5.  
  6. interface
  7.  
  8. uses crt;
  9.  
  10. procedure Loadconfig(
  11.  fn: string;
  12.  var bbs_software: byte;
  13.  var user_first_name,user_last_name: string;
  14.  var user_access_level: word;
  15.  var bbs_time_left: integer;
  16.  var com_port: byte;
  17.  var baud_rate: longint;
  18.  var node_num: byte;
  19.  var local: boolean;
  20.  var graphics: byte;
  21.  var color1: boolean;
  22.  var color_chg: boolean;
  23.  var X00extOk: boolean;
  24.  var board_name: string;
  25.  var pause_code: string;
  26.  var sysop_first_name: string;
  27.  var sysop_last_name: string;
  28.  var maxtime: word;
  29.  var localcol: boolean;
  30.  var statfore: byte;
  31.  var statback: byte;
  32.  var statline: boolean;
  33.  var ESMOk: boolean;
  34.  var fossilio: boolean;
  35.  var dropfilepath: string;
  36.  var GoRip : byte;
  37.  var lockbaud: longint;
  38.  var nodirect: boolean;
  39.  var port1,port2,port3,port4:word;
  40.  var irq1,irq2,irq3,irq4 : byte);
  41.  
  42. var
  43.  ddcfgp1,ddcfgp2,ddcfgps: string[80];
  44. const
  45.  DDUserConfigPtr: pointer = nil;
  46.  
  47. implementation
  48.  
  49. type
  50.  iomodetypes=(localu,remote);
  51. var
  52.  iomode: iomodetypes;
  53.  
  54. Procedure CallProc;
  55. inline($FF/$1E/DDUserConfigPtr);
  56.  
  57. procedure Loadconfig(
  58.  fn: string;
  59.  var bbs_software: byte;
  60.  var user_first_name,user_last_name: string;
  61.  var user_access_level: word;
  62.  var bbs_time_left: integer;
  63.  var com_port: byte;
  64.  var baud_rate: longint;
  65.  var node_num: byte;
  66.  var local: boolean;
  67.  var graphics: byte;
  68.  var color1: boolean;
  69.  var color_chg: boolean;
  70.  var X00extOk: boolean;
  71.  var board_name: string;
  72.  var pause_code: string;
  73.  var sysop_first_name: string;
  74.  var sysop_last_name: string;
  75.  var maxtime: word;
  76. { var quiet: boolean; }
  77.  var localcol: boolean;
  78.  var statfore: byte;
  79.  var statback: byte;
  80.  var statline: boolean;
  81.  var EsmOk: boolean;
  82.  var fossilio: boolean;
  83.  var dropfilepath: string;
  84.  var GoRip : byte;
  85.  var lockbaud: longint;
  86.  var nodirect: boolean;
  87.  var port1,port2,port3,port4:word;
  88.  var irq1,irq2,irq3,irq4 : byte);
  89.  
  90. function getparam(s: string; n: integer): string;
  91. var
  92.  a: integer;
  93.  s2: string;
  94. begin;
  95.  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  96.  if n<>1 then begin;
  97.   while (length(s)>0) and (s[1]<>' ') do delete(s,1,1);
  98.   while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  99.  end;
  100.  if n=3 then begin;
  101.   while (length(s)>0) and (s[1]<>' ') do delete(s,1,1);
  102.   while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  103.  end;
  104.  while (pos(' ',s)<>0) do begin;
  105.   a:=1;
  106.   s2:='';
  107.   while s[a]<>' ' do begin;
  108.    s2:=s2+upcase(s[a]);
  109.    a:=a+1;
  110.   end;
  111.   s:=s2;
  112.  end;
  113.  while (length(s)>0) and (s[length(s)]=' ') do delete(s,length(s),1);
  114.  for a:=1 to length(s) do s[a]:=upcase(s[a]);
  115.  getparam:=s;
  116. end;
  117.  
  118. function getsecond(s: string): string;
  119. var
  120.  a: integer;
  121.  s2: string;
  122. begin;
  123.  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  124.  while (length(s)>0) and (s[1]<>' ') do delete(s,1,1);
  125.  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  126.  while (length(s)>0) and (s[length(s)]=' ') do delete(s,length(s),1);
  127.  getsecond:=s;
  128. end;
  129.  
  130.  
  131. function numparams(s: string): integer;
  132. var
  133.  i: integer;
  134. begin;
  135.  i:=0;
  136.  numparams:=0;
  137.  if length(s)=0 then exit;
  138.  if s[1]=';' then exit;
  139.  if s[2]=';' then exit;
  140.  if getparam(s,1)<>'' then inc(i);
  141.  if getparam(s,2)<>'' then inc(i);
  142.  if getparam(s,3)<>'' then inc(i);
  143.  numparams:=i;
  144. end;
  145.  
  146. procedure Port_rtn (var s2,s3 : string;
  147.                     var portadd : word;
  148.                     var irq  : byte);
  149. var
  150.   a : integer;
  151. begin
  152.   val('$'+s2,portadd,a);
  153.   val(s3,irq,a);
  154. end;
  155.  
  156. procedure DDError(s: string);
  157. begin;
  158.  write(^G^G);
  159.  writeln('ERROR: '+s);
  160.  write(^G^G);
  161.  delay(2000);
  162. end;
  163.  
  164. procedure BadParam(s: string);
  165. begin;
  166.  dderror('Invalid parameter');
  167.  halt;
  168. end;
  169.  
  170. procedure processcmdline;
  171. var
  172.  a,b: integer;
  173.  s,s2: string;
  174. begin;
  175.  iomode:=remote;
  176.  dropfilepath:='';
  177.  for a:=1 to paramcount do begin;
  178.   s:=paramstr(a);
  179.   for b:=1 to length(s) do s[b]:=upcase(s[b]);
  180.   if (s[1]='/') and (length(s)>1) then begin;
  181.    delete(s,1,1);
  182.    s2:=s;
  183.    delete(s2,1,1);
  184.    case s[1] of
  185.     'B': val(s2,lockbaud,b);
  186.     'C': val(s2,com_port,b);
  187.     'E': EsmOk:=true;
  188.     'L': iomode:=localu;
  189.     'N': val(s2,node_num,b);
  190.     'P': begin;
  191.           if s2[length(s2)]<>'\' then s2:=s2+'\';
  192.           dropfilepath:=s2;
  193.          end;
  194.     'R': GoRip:=4;
  195.    end;
  196.   end;
  197.  end;
  198. end;
  199.  
  200. var
  201.  s: string;
  202.  f: text;
  203.  a,b,c: integer;
  204.  ps,p1,p2,p3: string[80];
  205.  ofm: word;
  206. begin;
  207.  maxtime:=999;
  208.  localcol:=true;
  209.  sysop_first_name:='STEVE';
  210.  sysop_last_name:='LORENZ';
  211.  board_name:='The Officers Club BBS';
  212.  pause_code:='@PAUSE@';
  213.  bbs_software:=1;
  214.  statline:=true;
  215.  nodirect:=false;
  216.  color1:=false;
  217.  EsmOK:=false;
  218.  fossilio:=false;
  219.  lockbaud:=0;
  220.  
  221.  ofm:=filemode;
  222.  filemode:=64;
  223.  assign(f,fn);
  224.  {$i-}
  225.  reset(f);
  226.  {$I+}
  227.  if ioresult<>0 then
  228.    begin
  229.      assign(f,'exdx.ctl');
  230.      {$i-}
  231.      reset(f);
  232.      {$I+}
  233.    end;
  234.  if ioresult<>0 then dderror('Configuration file, '+fn+', is missing!');
  235.  while not eof(f) do begin;
  236.   readln(f,s);
  237.   if numparams(s)>0 then begin;
  238.    p1:=getparam(s,1);
  239.    p2:=getparam(s,2);
  240.    p3:=getparam(s,3);
  241.    ps:=getsecond(s);
  242.  
  243.    if p1='COLOR' then localcol:=true else
  244.    if p1='MONO' then localcol:=false else
  245.    if p1='SYSOPFIRST' then sysop_first_name:=ps else
  246.    if p1='SYSOPLAST' then sysop_last_name:=ps else
  247.    if p1='BBSNAME' then board_name:=ps else
  248.    if p1='PAUSECODE' then pause_code:=ps else
  249.    if p1='BBSTYPE' then begin;
  250.     if p2='LOCAL' then bbs_software:=1;
  251.     if p2='QUICK' then bbs_software:=3 else
  252.     if p2='PCB12' then bbs_software:=4 else
  253.     if p2='WWIV' then bbs_software:=5 else
  254.     if p2='PCB15' then bbs_software:=6 else
  255.     if p2='RBBS' then bbs_software:=7 else
  256.     if p2='PHOENIX' then bbs_software:=8 else
  257.     if p2='CALLINFO' then bbs_software:=9 else
  258.     if p2='PCB14' then bbs_software:=10 else
  259.     if p2='WC30' then bbs_software:=11 else
  260.     if p2='DOORSYS' then bbs_software:=11 else
  261.     if p2='SPITFIRE' then bbs_software:=12 else
  262.     if p2='2AM' then bbs_software:=13 else
  263.     if p2='TRIBBS' then bbs_software:=14 else
  264.      badparam(s);
  265.    end else
  266.    if p1='STATUS' then begin;
  267.     if p2='OFF' then statline:=false else
  268.     if p2='ON' then statline:=true else
  269.      badparam(s);
  270.    end else
  271.    if p1='MAXTIME' then val(p2,maxtime,a) else
  272.    if p1='FOSSIL' then fossilio:=TRUE else
  273.    if p1='XFOSSIL' then
  274.        begin
  275.          fossilio:=true;
  276.          X00ExtOK:=true;
  277.        end                                 else
  278.   {  XFOSSIL    - Use X00 extended fossil. }
  279.    if p1='STATFORE' then val(p2,statfore,a) else
  280.    if p1='STATBACK' then val(p2,statback,a) else
  281.    if p1='COLOR1' then color1:=true else
  282.    if p1='COMPORT' then val(p2,com_port,a) else
  283.    if p1='LOCKBAUD' then val(p2,lockbaud,a) else
  284.    if p1='PORT1'    then port_rtn(p2,p3,port1,irq1) else
  285.    if p1='PORT2'    then port_rtn(p2,p3,port2,irq2) else
  286.    if p1='PORT3'    then port_rtn(p2,p3,port3,irq3) else
  287.    if p1='PORT4'    then port_rtn(p2,p3,port4,irq4) else
  288.  
  289.    begin;
  290.     ddcfgp1:=p1;
  291.     ddcfgp2:=p2;
  292.     ddcfgps:=ps;
  293.     if dduserconfigptr<>nil then callproc;
  294.    end;
  295.  
  296.   end;
  297.  end;
  298.  close(f);
  299.  filemode:=ofm;
  300.  
  301.  processcmdline;
  302.  case iomode of
  303.   remote: ;
  304.   localu: bbs_software:=1;
  305.  end;
  306. end;
  307.  
  308. end.
  309.  
  310. {
  311.  /E - Use ESM for extra memory');
  312.  /L - Local mode');
  313.  /Bxxx - Specify locked baud rate (i.e. /B38400)');
  314.  /C    - Specify comport number.
  315.  /Nx   - Specify node number');
  316.  /R    - Force RIP graphics');
  317.  /Pyyy - Specify path to drop file (i.e. /Pc:\bbs');
  318.  
  319.     }
  320.